VERSION 5.00
Begin VB.UserControl shpActivator 
   AutoRedraw      =   -1  'True
   BackColor       =   &H000000FF&
   ClientHeight    =   3600
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4800
   ForwardFocus    =   -1  'True
   ScaleHeight     =   3600
   ScaleWidth      =   4800
End
Attribute VB_Name = "shpActivator"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Const ALTERNATE = 1 ' ALTERNATE and WINDING are
Const WINDING = 2 ' constants for FillMode.

Private m_Parent As Object
Attribute m_Parent.VB_VarHelpID = -1
Private m_Index As Long
Private m_Link As Object
Private m_Left As Double, m_Top As Double
Private m_Focus As Boolean

Private Declare Function SetWindowRgn Lib "user32" ( _
    ByVal hWnd As Long, _
    ByVal hRgn As Long, _
    ByVal bRedraw As Long _
) As Long

Private Declare Function CreatePolygonRgn Lib "gdi32" ( _
    lpPoint As Any, _
    ByVal nCount As Long, _
    ByVal nPolyFillMode As Long _
) As Long

Private Declare Function FillRgn Lib "gdi32" ( _
    ByVal hdc As Long, _
    ByVal hRgn As Long, _
    ByVal hBrush As Long _
) As Long

Private Declare Function DeleteObject Lib "gdi32" ( _
    ByVal hObject As Long _
) As Long

Private Declare Function CreateSolidBrush Lib "gdi32" ( _
    ByVal crColor As Long _
) As Long

Public Event Move(ByVal X As Double, ByVal Y As Double)
Public Event Destruct()

Property Get Index() As Long
    Index = m_Index
End Property

Property Let Index(ind As Long)
    m_Index = ind
End Property

Property Get Parent() As Object
    Set Parent = m_Parent
End Property

Property Let Parent(par As Object)
    Set m_Parent = par
End Property

Property Get Link() As Object
    Set Link = m_Link
End Property

Property Let Link(lin As Object)
    Set m_Link = lin
End Property

Property Get nLeft() As Double
    nLeft = m_Left
End Property

Property Get nTop() As Double
    nTop = m_Top
End Property

Public Sub Position(ByVal lef As Double, ByVal top As Double)
    If lef > 0 Then
        m_Left = lef
    Else
        m_Left = 0
    End If
    If top > 0 Then
        m_Top = top
    Else
        m_Top = 0
    End If
    Move
End Sub

Public Sub Move()
    RaiseEvent Move(m_Left, m_Top)
End Sub

Public Sub Destruct()
    RaiseEvent Destruct
End Sub

Public Sub Focus(Optional flg As Boolean = True)
    If flg Then
        BackColor = IIf(m_ActivePort Is Me, c_ColorSelectPort, c_ColorFocusPort)
    Else
        BackColor = IIf(m_ActivePort Is Me, c_ColorSelectPort, c_ColorActivator)
    End If
    m_Focus = flg
    UserControl_Paint
End Sub

Private Sub UserControl_Initialize()
    UserControl.BackColor = c_ColorActivator
    UserControl.Width = c_WidthPort
    UserControl.Height = c_HeightPort
End Sub

Private Sub UserControl_MouseDown( _
    Button As Integer, _
    Shift As Integer, _
    X As Single, _
    Y As Single _
)
    Dim con As shpConnector
    Set m_ActiveObject = Me
    Select Case Button
        Case vbLeftButton
        Case vbRightButton
        Case vbMiddleButton
            If m_ActivePort Is Nothing Then
                Set m_ActivePort = Me
                Focus True
            ElseIf m_ActivePort Is Me Then
                Set m_ActivePort = Nothing
                Focus False
            Else
                Set con = m_Editor.AddConnector(m_ActivePort, Me)
                Set m_ActivePort = Nothing
                con.Port1.Focus False
                Focus False
            End If
    End Select
End Sub

Private Sub UserControl_MouseUp( _
    Button As Integer, _
    Shift As Integer, _
    X As Single, _
    Y As Single _
)
    Select Case Button
        Case vbLeftButton
        Case vbRightButton
            m_Editor.InvokeMenu inActivatorMenu
        Case vbMiddleButton
    End Select
End Sub

Private Sub UserControl_MouseMove( _
    Button As Integer, _
    Shift As Integer, _
    X As Single, _
    Y As Single _
)
    MousePointer = vbArrow
End Sub

Private Sub UserControl_Paint()
    Dim rmb As Long, rmb2 As Long, rgn(4) As Point, rgn2(4) As Point, twX As Single, twY As Single, bru As Long, ret As Long
    twX = Screen.TwipsPerPixelX
    twY = Screen.TwipsPerPixelY
    rgn(0).X = Width / (2 * twX)
    rgn(0).Y = 0
    rgn(1).X = 0
    rgn(1).Y = Height / (2 * twY)
    rgn(2).X = Width / (2 * twX)
    rgn(2).Y = Height / twY
    rgn(3).X = Width / twX
    rgn(3).Y = Height / (2 * twY)
    rmb = CreatePolygonRgn(rgn(0), 4, ALTERNATE)
    If m_Focus Then
        rgn2(0).X = rgn(0).X
        rgn2(0).Y = rgn(0).Y + c_BorderPort * 1.5
        rgn2(1).X = rgn(1).X + c_BorderPort * 1.5
        rgn2(1).Y = rgn(1).Y
        rgn2(2).X = rgn(2).X
        rgn2(2).Y = rgn(2).Y - c_BorderPort * 1.5
        rgn2(3).X = rgn(3).X - c_BorderPort * 1.5
        rgn2(3).Y = rgn(3).Y
        rmb2 = CreatePolygonRgn(rgn2(0), 4, ALTERNATE)
        bru = CreateSolidBrush(c_ColorActivator)
        ret = FillRgn(hdc, rmb2, bru)
        DeleteObject rmb2
    End If
    SetWindowRgn hWnd, rmb, True
    DeleteObject rmb
End Sub

Private Sub UserControl_Resize()
    UserControl_Paint
End Sub

Private Sub UserControl_GotFocus()
    Focus True
End Sub

Private Sub UserControl_LostFocus()
    Focus False
End Sub

Private Sub UserControl_Unload()

End Sub

